/*PROGRAM
		ARP010 - A/R CUSTOMER MASTER FILE MAINTENANCE
  PROGRAMMER
		ROBERT M. WHITE
  DATE WRITTEN
		APRIL 15, 1981
  PURPOSE
		THIS PROGRAM ALLOWS THE OPERATOR TO UPDATE THE
		A/R CUSTOMER MASTER FILE RECORDS.  THIS INCLUDES
		ALL COMMON MAINTENANCE FUNCTIONS.
  INPUT
  OUTPUT
  REMARKS
*/

ARP010: PROC;
/* * * *   CUSTOMER MASTER FILE MAINTENANCE PROGRAM  * * * */

/* * *  PROGRAM REPLACEMENTS  * * */
%INCLUDE 'C:BTCCS.PLI';
%INCLUDE 'C:BTERRCS.PLI';
%REPLACE FALSE BY '0'B;
%REPLACE TRUE BY '1'B;

/* * *  PROGRAM AREAS  * * */
	DCL	I BIN(15);    /* INDEX VARIABLE */
	DCL	RP CHAR(1);  /* CHAR RESPONSE */
	DCL	NRP BIN(15);  /* NUMERIC RESPONSE */
	DCL	RTN_COD BIN(7); /* RETURN CODE */

/* * *  COMMON DCL INCLUDES  * * */
%INCLUDE 'C:SUBS1.DCL';
%INCLUDE 'ARCOMMON.DCL';
%INCLUDE 'ARCUSTM.DCL';

/* * *  COMMON PROC INCLUDES * * */
	DCL	BTREE ENTRY(BIN(7),BIN(7),PTR,BIN(7));
	DCL	ARM010 ENTRY;	/* SCREEN ROUTINES */
	DCL	ARM011 ENTRY;

/* * *  ZERO RECORD.  * * */
ZERO_MSTR: PROC;
	REC1.CSID=' ';
	REC1.CSBILCON=' ';
	REC1.CSBILCMP=' ';
	REC1.CSBILAD1=' ';
	REC1.CSBILAD2=' ';
	REC1.CSBILAD3=' ';
	REC1.CSBILZIP=' ';
	REC1.CSBILTEL=' ';
	REC1.CSBILEXT=0;
	REC1.CSTECCON=' ';
	REC1.CSTECCMP=' ';
	REC1.CSTECAD1=' ';
	REC1.CSTECAD2=' ';
	REC1.CSTECAD3=' ';
	REC1.CSTECZIP=' ';
	REC1.CSTECTEL=' ';
	REC1.CSTECEXT=0;
	REC1.CSSTAT=' ';
	REC1.CSTERM=' ';
	REC1.CSBALTYP=' ';
	REC1.CSPRCCOD=' ';
	REC1.CSDISC=' ';
	REC1.CSTAXCOD=' ';
	REC1.CSCURAMT=0;
	REC1.CS30DAMT=0;
	REC1.CS60DAMT=0;
	REC1.CSOVRAMT=0;
	REC1.CSLYRAMT=0;
	REC1.CSSPCL=' ';
	END;

/* * *  ENTER A FIELD.  * * */
GET_FLD: PROC (I);
	DCL	I BIN(7);
	GOTO FLDGET(I);
FLDGET(01):
	CALL GETSTR(04,17,LENGTH(REC1.CSBILCON),ADDR(REC1.CSBILCON),
			RTN_COD);
	RETURN;
FLDGET(02):
	CALL GETSTR(05,17,LENGTH(REC1.CSBILCMP),ADDR(REC1.CSBILCMP),
			RTN_COD);
	RETURN;
FLDGET(03):
	CALL GETSTR(06,17,LENGTH(REC1.CSBILAD1),ADDR(REC1.CSBILAD1),
			RTN_COD);
	RETURN;
FLDGET(04):
	CALL GETSTR(07,17,LENGTH(REC1.CSBILAD2),ADDR(REC1.CSBILAD2),
			RTN_COD);
	RETURN;
FLDGET(05):
	CALL GETSTR(08,17,LENGTH(REC1.CSBILAD3),ADDR(REC1.CSBILAD3),
			RTN_COD);
	RETURN;
FLDGET(06):
	CALL GETSTR(08,49,LENGTH(REC1.CSBILZIP),ADDR(REC1.CSBILZIP),
			RTN_COD);
	RETURN;
FLDGET(07):
	CALL GETSTR(09,17,LENGTH(REC1.CSBILTEL),ADDR(REC1.CSBILTEL),
			RTN_COD);
	RETURN;
FLDGET(08):
	CALL GETB15(09,36,REC1.CSBILEXT,0,9999,RTN_COD);
	RETURN;
FLDGET(09):
	CALL GETSTR(11,17,LENGTH(REC1.CSTECCON),ADDR(REC1.CSTECCON),
			RTN_COD);
	RETURN;
FLDGET(10):
	CALL GETSTR(12,17,LENGTH(REC1.CSTECCMP),ADDR(REC1.CSTECCMP),
			RTN_COD);
	RETURN;
FLDGET(11):
	CALL GETSTR(13,17,LENGTH(REC1.CSTECAD1),ADDR(REC1.CSTECAD1),
			RTN_COD);
	RETURN;
FLDGET(12):
	CALL GETSTR(14,17,LENGTH(REC1.CSTECAD2),ADDR(REC1.CSTECAD2),
			RTN_COD);
	RETURN;
FLDGET(13):
	CALL GETSTR(15,17,LENGTH(REC1.CSTECAD3),ADDR(REC1.CSTECAD3),
			RTN_COD);
	RETURN;
FLDGET(14):
	CALL GETSTR(15,49,LENGTH(REC1.CSTECZIP),ADDR(REC1.CSTECZIP),
			RTN_COD);
	RETURN;
FLDGET(15):
	CALL GETSTR(16,17,LENGTH(REC1.CSTECTEL),ADDR(REC1.CSTECTEL),
			RTN_COD);
	RETURN;
FLDGET(16):
	CALL GETB15(16,36,REC1.CSTECEXT,0,9999,RTN_COD);
	RETURN;
FLDGET(17):
	CALL GETSTR(18,12,LENGTH(REC1.CSSTAT),ADDR(REC1.CSSTAT),
			RTN_COD);
	RETURN;
FLDGET(18):
	CALL GETSTR(18,25,LENGTH(REC1.CSTERM),ADDR(REC1.CSTERM),
			RTN_COD);
	RETURN;
FLDGET(19):
	CALL GETSTR(18,46,LENGTH(REC1.CSBALTYP),ADDR(REC1.CSBALTYP),
			RTN_COD);
	RETURN;
FLDGET(20):
	CALL GETSTR(18,64,LENGTH(REC1.CSPRCCOD),ADDR(REC1.CSPRCCOD),
			RTN_COD);
	RETURN;
FLDGET(21):
	CALL GETSTR(18,76,LENGTH(REC1.CSDISC),ADDR(REC1.CSDISC),
			RTN_COD);
	RETURN;
FLDGET(22):
	CALL GETSTR(19,14,LENGTH(REC1.CSTAXCOD),ADDR(REC1.CSTAXCOD),
			RTN_COD);
	RETURN;
FLDGET(23):
	CALL GETSTR(19,29,LENGTH(REC1.CSSPCL),ADDR(REC1.CSSPCL),
			RTN_COD);
	RETURN;
FLDGET(24):
	CALL GETD92(20,13,REC1.CSCURAMT,0,0,RTN_COD);
	RETURN;
FLDGET(25):
	CALL GETD92(20,39,REC1.CS30DAMT,0,0,RTN_COD);
	RETURN;
FLDGET(26):
	CALL GETD92(20,65,REC1.CS60DAMT,0,0,RTN_COD);
	RETURN;
FLDGET(27):
	CALL GETD92(21,13,REC1.CSOVRAMT,0,0,RTN_COD);
	RETURN;
FLDGET(28):
	CALL GETD92(21,41,REC1.CSLYRAMT,0,0,RTN_COD);
	RETURN;
	END GET_FLD;

/* * *  UPDATE A FIELD  * * */
UPD_FLDS: PROC;
	DCL	I BIN(15);
UPD_LOOP:
	CALL	EOL(23,1);
	CALL	PUTMSG(23,1,
		  'PLEASE ENTER FIELD NUMBER TO CHANGE OR <ENTER> FOR END: ');
	CALL GETB15(23,57,I,0,28,RTN_COD);
	IF I=0 THEN 
	   RETURN;
	CALL	GET_FLD(I);
	GOTO	UPD_LOOP;
	END UPD_FLDS;

/* * *  PRINT A RECORD.  * * */
PRNT_MSTR: PROC;
	CALL ARM011;	/* PUT BACKGROUND ON SCREEN. */
	CALL PUTSTR(04,17,LENGTH(REC1.CSBILCON),ADDR(REC1.CSBILCON));
	CALL PUTSTR(05,17,LENGTH(REC1.CSBILCMP),ADDR(REC1.CSBILCMP));
	CALL PUTSTR(06,17,LENGTH(REC1.CSBILAD1),ADDR(REC1.CSBILAD1));
	CALL PUTSTR(07,17,LENGTH(REC1.CSBILAD2),ADDR(REC1.CSBILAD2));
	CALL PUTSTR(08,17,LENGTH(REC1.CSBILAD3),ADDR(REC1.CSBILAD3));
	CALL PUTSTR(08,49,LENGTH(REC1.CSBILZIP),ADDR(REC1.CSBILZIP));
	CALL PUTSTR(09,17,LENGTH(REC1.CSBILTEL),ADDR(REC1.CSBILTEL));
	CALL PUTB15(09,36,REC1.CSBILEXT);
	CALL PUTSTR(11,17,LENGTH(REC1.CSTECCON),ADDR(REC1.CSTECCON));
	CALL PUTSTR(12,17,LENGTH(REC1.CSTECCMP),ADDR(REC1.CSTECCMP));
	CALL PUTSTR(13,17,LENGTH(REC1.CSTECAD1),ADDR(REC1.CSTECAD1));
	CALL PUTSTR(14,17,LENGTH(REC1.CSTECAD2),ADDR(REC1.CSTECAD2));
	CALL PUTSTR(15,17,LENGTH(REC1.CSTECAD3),ADDR(REC1.CSTECAD3));
	CALL PUTSTR(15,49,LENGTH(REC1.CSTECZIP),ADDR(REC1.CSTECZIP));
	CALL PUTSTR(16,17,LENGTH(REC1.CSTECTEL),ADDR(REC1.CSTECTEL));
	CALL PUTB15(16,36,REC1.CSTECEXT);
	CALL PUTSTR(18,12,LENGTH(REC1.CSSTAT),ADDR(REC1.CSSTAT));
	CALL PUTSTR(18,25,LENGTH(REC1.CSTERM),ADDR(REC1.CSTERM));
	CALL PUTSTR(18,46,LENGTH(REC1.CSBALTYP),ADDR(REC1.CSBALTYP));
	CALL PUTSTR(18,64,LENGTH(REC1.CSPRCCOD),ADDR(REC1.CSPRCCOD));
	CALL PUTSTR(18,76,LENGTH(REC1.CSDISC),ADDR(REC1.CSDISC));
	CALL PUTSTR(19,14,LENGTH(REC1.CSTAXCOD),ADDR(REC1.CSTAXCOD));
	CALL PUTSTR(19,29,LENGTH(REC1.CSSPCL),ADDR(REC1.CSSPCL));
	CALL PUTD92(20,13,ADDR(REC1.CSCURAMT));
	CALL PUTD92(20,39,ADDR(REC1.CS30DAMT));
	CALL PUTD92(20,65,ADDR(REC1.CS60DAMT));
	CALL PUTD92(21,13,ADDR(REC1.CSOVRAMT));
	CALL PUTD92(21,41,ADDR(REC1.CSLYRAMT));
	END PRNT_MSTR;

/* *	PRINT SECTION HEADING    * */
PRNT_HDNG: PROC (SUB);
	DCL	SUB CHAR(25) VARYING;
	DCL	BLANKS CHAR(13) STATIC INITIAL(' ');
	DCL	NUM_BLANKS BIN(15);

/* ADJUST INPUT. */
	NUM_BLANKS=DIVIDE(25-LENGTH(SUB),2,5);
	IF LENGTH(SUB)<25 THEN
	   SUB=SUBSTR(BLANKS,1,NUM_BLANKS)||SUB;

/* PRINT HEADINGS. */
	CALL CLRSCRN;
	CALL PUTMSG(1,15,'* * *  CUSTOMER FILE MAINTENANCE  * * *');
	CALL PUTMSG(2,22,SUB);

/* RETURN TO CALLER. */
	END PRNT_HDNG;

/* * *  START OF MAIN PROGRAM  * * */
MAIN_MENU:
	BEGIN;
	CALL ARM010;	/* PRINT MENU */
	CALL GETB15(09,23,NRP,0,04,RTN_COD); /* GET FUNCTION NUMBER. */
	GOTO MAIN_FUNC(NRP);	/* PERFORM THE FUNCTION. */
	END; /* MAIN_MENU */

/* * *  RETURN TO MAIN MENU  * * */
MAIN_FUNC(00):
	BEGIN;
	CALL CLRSCRN;
	CALL PUTMSG(1,1,'RETURNING TO MASTER MENU...');
	RETURN;
	END;

/* * *  ADD BY ID  * * */
MAIN_FUNC(01):
	BEGIN;
/* GET THE KEY FIELD. */
	CALL ZERO_MSTR;			/* ZERO THE RECORD. */
	CALL PRNT_HDNG('***ADD A CUSTOMER***');
	CALL PUTMSG(3,1,'ENTER ID:');
	CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
	IF REC1.CSID=' ' THEN
	   DO;
	     CALL PUTERR('*** 1)ID IS INVALID OR MISSING. ***');
	     GOTO ADD_NEXT;
	   END;
	CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
              CALL PUTERR('RECORD ALREADY EXISTS!');
	      GOTO ADD_NEXT;
           END;
        IF RTN_COD=3 THEN  /* RECORD DOESN'T EXIST.*/
           DO;
           END;
        ELSE
	   DO;
              CALL PUTERR('ADD RETURN CODE ='||RTN_COD||'.');
	      GOTO ADD_NEXT;
	   END;

/* GET EACH FIELD IN THE RECORD. */
	CALL PRNT_HDNG('ADDING: '||REC1.CSID);
	CALL PRNT_MSTR;			/* FORMAT THE SCREEN. */
	CALL EOL(23,1);			/* ERASE CURRENT LINE. */
	CALL PUTMSG(23,1,'PLEASE ENTER EACH FIELD AS PROMPTED.');
	DO I=1 TO 28;
	  CALL GET_FLD(I);
	END;
	CALL UPD_FLDS;

/* ADD THE RECORD TO THE FILE. */
	CALL BTREE(BT_WRITE,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
              CALL PUTERR('RECORD SUCCESSFULLY ADDED');
           END;
        ELSE
	   DO;
              CALL PUTERR('ADD RETURN CODE ='||RTN_COD||'.');
	   END;

/* EITHER RETURN OR DO ANOTHER RECORD */
ADD_NEXT:
	CALL EOL(23,1);			/* ASK ABOUT ANOTHER ADD */
	CALL PUTMSG(23,1,'DO YOU WISH TO ADD ANOTHER N/A (Y/N)? ');
	CALL GETSTR(23,39,1,ADDR(RP),RTN_COD);
	IF RP~='N' THEN
	  GOTO MAIN_FUNC(01);
	GOTO MAIN_MENU;
	END;

/* * *  UPDATE BY ID  * * */
MAIN_FUNC(02):
	BEGIN;
/* GET THE RECORD TO BE UPDATED */
	CALL PRNT_HDNG('***UPDATE A CUSTOMER***');
	CALL PUTMSG(3,1,'ENTER ID:');
	CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
	IF REC1.CSID=' ' THEN
	   DO;
	     CALL PUTERR('*** 1)ID IS INVALID OR MISSING. ***');
	     GOTO UPD_NEXT;
	   END;
	CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
           END;
        ELSE
	   DO;
              CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
	      GOTO UPD_NEXT;
	   END;

/* UPDATE THE FIELDS IN THIS RECORD */
	CALL PRNT_HDNG('UPDATING: '||REC1.CSID);
	CALL PRNT_MSTR;			/* FORMAT THE SCREEN. */
	CALL UPD_FLDS;

/* UPDATE THE RECORD. */
	CALL BTREE(BT_UPDATE,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
	      CALL PUTERR('RECORD SUCCESSFULLY UPDATED.');
           END;
        ELSE
	   DO;
              CALL PUTERR('UPDATE RETURN CODE ='||RTN_COD||'.');
	   END;

/* EITHER RETURN OR DO ANOTHER RECORD. */
UPD_NEXT:
	CALL EOL(23,1);			/* ASK ABOUT ANOTHER ADD */
	CALL PUTMSG(23,1,'DO YOU WISH TO UPDATE ANOTHER N/A (Y/N)? ');
	CALL GETSTR(23,42,1,ADDR(RP),RTN_COD);
	IF RP~='N' THEN
	  GOTO MAIN_FUNC(02);
	GOTO MAIN_MENU;
	END;

/* * *  DELETE BY ID  * * */
MAIN_FUNC(03):
	BEGIN;
/* GET THE RECORD. */
	CALL PRNT_HDNG('***DELETE A CUSTOMER***');
	CALL PUTMSG(3,1,'ENTER ID:');
	CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
	CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
           END;
        ELSE
	   DO;
              CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
	      GOTO DELT_NEXT;
	   END;

/* DISPLAY THE RECORD. */
	CALL PRNT_HDNG('DELETING: '||REC1.CSID);
	CALL PRNT_MSTR;			/* FORMAT THE SCREEN. */

/* ISSUE THE DELETE TO MDBS. */
	CALL PUTMSG(23,1,'DO YOU REALLY WANT TO DELETE THIS(Y/N)? ');
	CALL GETSTR(23,41,1,ADDR(RP),RTN_COD);
	IF RP~='Y' THEN
	   GOTO DELT_NEXT;
	CALL BTREE(BT_DELETE,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
	      CALL PUTERR('DELETE WAS SUCCESSFUL.');
           END;
        ELSE
	   DO;
              CALL PUTERR('DELETE RETURN CODE ='||RTN_COD||'.');
	   END;

/* EITHER RETURN OR DO ANOTHER RECORD. */
DELT_NEXT:
	CALL EOL(23,1);			/* ASK ABOUT ANOTHER ADD */
	CALL PUTMSG(23,1,'DO YOU WISH TO DELETE ANOTHER N/A (Y/N)? ');
	CALL GETSTR(23,42,1,ADDR(RP),RTN_COD);
	IF RP~='N' THEN
	  GOTO MAIN_FUNC(03);
	GOTO MAIN_MENU;
	END;

/* * *  DISPLAY BY ID  * * */
MAIN_FUNC(04):
	BEGIN;
/* GET THE RECORD TO BE DISPLAYED. */
	CALL PRNT_HDNG('***DISPLAY A CUSTOMER***');
	CALL PUTMSG(3,1,'ENTER ID:');
	CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
	CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD);
        IF RTN_COD=0 THEN
           DO;
           END;
        ELSE
	   DO;
              CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
	      GOTO DSPL_NEXT;
	   END;

/* DISPLAY THE RECORD. */
	CALL PRNT_HDNG('DISPLAYING: '||REC1.CSID);
	CALL PRNT_MSTR;			/* FORMAT THE SCREEN. */

/* EITHER RETURN OR DO ANOTHER RECORD. */
DSPL_NEXT:
	CALL EOL(23,1);			/* ASK ABOUT ANOTHER ADD */
	CALL PUTMSG(23,1,'DO YOU WISH TO DISPLAY ANOTHER N/A (Y/N)? ');
	CALL GETSTR(23,42,1,ADDR(RP),RTN_COD);
	IF RP~='N' THEN
	  GOTO MAIN_FUNC(04);
	GOTO MAIN_MENU;
	END;

	END ARP010;
